home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 09 - 1993 / 09.04 Apr 93 / CRCs in Pascal / CRCTableBuild next >
Encoding:
Text File  |  1992-01-22  |  1.9 KB  |  85 lines  |  [TEXT/PJMM]
  1. program Main;
  2.  
  3.     uses
  4.         Profiler;
  5.  
  6.     var
  7.         crcTable: array[0..255] of longint;
  8.         crcCC1, crcCC2: longint;
  9.         x: integer;
  10.  
  11.     procedure DoCrcBitCalc;
  12.         const
  13.             hiBitMask = $08000;
  14.             polyCCITT = $01021;
  15.             polyCRC16 = $0A001;
  16.         var
  17.             loop, i: integer;
  18.             tempdata, crcXor: longint;
  19.     begin
  20.         crcCC2 := 0;
  21.         for i := 0 to 255 do
  22.             begin
  23.                 tempData := i;
  24.                 crcCC2 := BitXor(BitShift(tempData, 8), crcCC2);
  25.                 for loop := 1 to 8 do
  26.                     begin
  27.                         crcXor := BitAnd(crcCC2, hiBitMask);
  28.                         if BitTst(@crcXor, 16) then
  29.                             crcCC2 := BitXor(BitShift(crcCC2, 1), polyCCITT)
  30.                         else
  31.                             crcCC2 := BitShift(crcCC2, 1);
  32.                     end;
  33.                 crcCC2 := BitAnd(crcCC2, 65535);
  34.             end;
  35.     end;
  36.  
  37.  
  38.     procedure DoTableTest;
  39.         var
  40.             i: integer;
  41.             tempData, crc: longint;
  42.     begin
  43.         crcCC1 := 0;
  44.         for i := 0 to 255 do
  45.             begin
  46.                 tempData := i;
  47.                 crcCC1 := BitAnd(BitXor(BitShift(crcCC1, 8), crcTable[BitAnd(BitXor(BitShift(crcCC1, -8), tempData), 255)]), 65535);
  48.             end;
  49.     end;
  50.  
  51.  
  52.     procedure MakeCRCTable;
  53.         const
  54.             hiBitMask = $08000;
  55.             polyCCITT = $01021;                                            {CRC-CCITT polynomial}
  56.             polyCRC16 = $0A001;                                            {CRC16 polynomial}
  57.         var
  58.             crcCC, crcXor, i, tableCounter: longint;
  59.             loop: byte;
  60.     begin
  61.         for tableCounter := 0 to 255 do
  62.             begin
  63.                 crcCC := 0;                                                    {must be set to zero}
  64.                 crcCC := BitXor(BitShift(tableCounter, 8), crcCC);
  65.                 for loop := 1 to 8 do
  66.                     begin
  67.                         crcXor := BitAnd(crcCC, hiBitMask);                    {get the high bit value}
  68.                         if BitTst(@crcXor, 16) then                            {is the bit set}
  69.                             crcCC := BitXor(BitShift(crcCC, 1), polyCCITT)    {then shift and subtract the poly}
  70.                         else
  71.                             crcCC := BitShift(crcCC, 1);                            {then just shift for the next test}
  72.                     end;
  73.                 crcTable[tableCounter] := BitAnd(crcCC, 65535);        {save it in the table}
  74.             end;
  75.     end;
  76.  
  77. begin
  78.     MakeCRCTable;
  79.     for x := 0 to 9 do
  80.         begin
  81.             DoCrcBitCalc;
  82.             DoTableTest;
  83.         end;
  84.     DumpProfileToFile('CRCTestFile');
  85. end.